-- card: 4530 from stack: in.3 -- bmap block id: 0 -- flags: 4000 -- background id: 3241 -- name: PrintField ----- HyperTalk script ----- on Install put ChooseTargetStack() into stackName InstallResource XCMD,PrintField,stackName InstallResource DITL,PrintField,stackName InstallResource DLOG,PrintField,stackName end Install -- part 1 (button) -- low flags: 00 -- high flags: A003 -- rect: left=52 top=300 right=322 bottom=221 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Print the Documentation ----- HyperTalk script ----- on mouseUp printfield "field 1",2 get the result if it is not empty then put it end mouseUp -- part 12 (field) -- low flags: 81 -- high flags: 2007 -- rect: left=12 top=26 right=298 bottom=491 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 0 -- font id: 22 -- text size: 10 -- style flags: 0 -- line height: 13 -- part name: Source -- part 13 (button) -- low flags: 00 -- high flags: A003 -- rect: left=299 top=300 right=322 bottom=438 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Show Pascal Source ----- HyperTalk script ----- on mouseUp set the visible of card field 1 to not the visible of card field 1 if the visible of card field 1 is true then set the name of me to "Hide Pascal Source" else set the name of me to "Show Pascal Source" end mouseUp -- part contents for background part 16 ----- text ----- PRINTFIELD XCMD version 1.5.1 Kevin Calhoun NOTE TO USERS OF EARLIER VERSIONS: The parameter list of PrintField changed with version 1.4. Please be sure to read "CHANGES FROM VERSIONS 1.0 AND 1.2" if you want to replace those earlier versions in your stacks. The PrintField XCMD prints the text of a field in the field's current textFont, textSize, textStyle, textHeight, and width. You may supply additional information about margins in order to place the text anywhere you like on the page. PrintField uses a dialog box to inform the user that printing is in progress. It passes to the printer driver the short name of the field to be printed as the document name. In case of an error, PrintField returns an error message as the Result. Word 1 of this message will be "Error". If the user presses the cancel button in either of the print job dialog boxes, the Result will be "Cancel". PrintField can print only one field at a time. It works with both the LaserWriter and the ImageWriter. CHANGES FROM VERSIONS 1.0 AND 1.2 The parameter list changed with version 1.4 in order to accommodate users who wanted the option of skipping the Page Setup and Print Job dialog boxes. A new parameter, called dialogCount, was added after the field designation and before the margin settings to specify which of the print dialog boxes the user sees. If you used margin settings with earlier versions of PrintField, you will have to alter your scripts to accord with the new parameter list used by versions 1.4 and later. INVOKING PRINTFIELD PrintField "fieldDesignation",,,,, Parameters given inside the brackets, such as , are optional. fieldDesignation: You may designate the field to print in any way considered valid by HyperCard, by number, id, or name, with one exception: you can't use the field's name if it is more than one word. If you do use the field's name, don't put the field name in quotation marks, because nested quotations confuse HyperCard. (See the examples below.) dialogCount: If dialogCount is 2 (or anything other than 0 or 1), then the user will see both the Page Setup and the Print Job dialog boxes before the printing process begins. If dialogCount is 1, then the user will see only the Print Job dialog box. If dialogCount is 0, then neither of these dialog boxes will appear before printing. If you set dialogCount equal to 0 or 1, thereby suppressing one or both of the print dialogs, the default settings stored in the printer resource file will be used for the print job, just as if the user clicked "OK" without changing any of the settings in the dialog. There is no way in this version to set such things as paper orientation or number of copies to values other than the defaults by any means other than the dialog boxes. Moreover, PrintField is unable to access the settings the user designates by choosing Page Setup from HyperCard's File menu. If you want to enable printing with settings other than the defaults, set dialogCount to 2. Setting Margins: Values for leftMargin, rightMargin, topMargin, and bottomMargin are given in pixels. According to QuickDraw, one pixel equals 1/72 inch; therefore you can specify a one inch margin by passing 72 as the margin parameter. If you don't supply margin parameters, PrintField defaults to half-inch margins on the top, left, and bottom of the page, and prints each line of the text about as wide as it appears on the screen. Valid Examples-- 1. PrintField "bkgnd field 1" -- default values will be used for margins 2. PrintField "bkgnd field 1",0,0,0,0,0 -- this will print as much as possible on a page 3. PrintField "card field id 22",2,72,72,72,72 -- by id, with one inch margins all around 4. PrintField "card field foo",2,72 -- by name, with a left margin one inch wide See the script of the button "Print the Documentation" for another example. It is possible to put the designation of the field into a variable and then pass the variable to PrintField, as follows… on openField if the optionKey is down then put the name of the target into theName put the id of the target into theField if word 1 of theName is "card" then put "card field id " before theField else put "field id " before theField PrintField theField end if end openField This handler prints a field if the field is clicked while the option key is down. COPYING PRINTFIELD INTO YOUR STACKS Warning to ResEdit and ResCopy users: PrintField requires a DLOG resource and a DITL resource as well as the XCMD resource--these resources are named "PrintField" and numbered 9140 (the same number as the PrintField XCMD) so you can find them easily. If either the DITL or the DLOG resource is not present, PrintField will still print properly, and printing can still be canceled by pressing command-period, but the user won't have the benefit of the information the dialog provides. THE COMMAND-PERIOD PROBLEM In early versions of HyperCard, when background printing was not enabled, the print job was not aborted properly when the user pressed command-period. HyperCard intercepted command-period keypresses before the Print Manager saw them and interpreted them as the user's signal to abort the execution of the current script. Therefore, the print job was aborted by HyperCard preventing PrintField from completing and exiting normally and not according to the proper method, which requires further communication with the Print Manager for the printer driver to clean up after itself. A number of difficulties would arise as a result--when the current printer was a LaserWriter, its status dialog box was not removed from the screen, and on occasion the Macintosh would bomb. This problem has gone away in HyperCard 1.2.2--command-period keypresses no longer interrupt XCMD's. CHANGE HISTORY 3/7/88 1.0 3/17/88 1.1 -- Fixed erasure problem when printing on LaserWriter with a small lineHeight. 4/7/88 1.2 -- Dialog now centered on third party screens also. 6/8/88 1.4 -- Fixed problem printing multiple pages on ImageWriter. Improved error handling to accord with changes in HyperCard 1.2. Added option of skipping one or both print dialogs. Improved WYSIWYG default margins (the width of the line on the page is much more often the same as it appears on the screen). Fixed problem with last line of page when font ascent was small. 2/24/89 1.5 -- Altered source code for compatibility with MPW Pascal 3.0. Added use of watch cursor, because Roger waved the interface guidelines at me. 3/15/89 1.5.1 -- Switched to trap-based printing manager. PrintField now requires System 4.1 or later, which shouldn't be a hardship for HyperCard users. Also, now returns "Cancel" as the result when user presses cancel button in either dialog. NOTES FOR PROGRAMMERS: PrintField contains code for finding out about all the properties of a field. You might find the functions GetFontOfField, GetJustOfField, etc., to be useful in your XCMD's. -- part contents for card part 12 ----- text ----- UNIT PrintUnit; { PrintField XCMD ©1988-1989 by the Trustees of Dartmouth College } { Written by Kevin Calhoun } { This source compatible with MPW Pascal 3.0 } (* Pascal PrintField.p Link -m ENTRYPOINT ∂ -o "YourFile" ∂ -rt XCMD=9140 ∂ -sn Main=PrintField ∂ PrintField.p.o ∂ "{Libraries}"interface.o ∂ "{PLibraries}"Paslib.o ∂ "{Libraries}"HyperXLib.o *) {$R-} INTERFACE USES Types, Memory, QuickDraw, OSEvents, Desk, ToolUtils, Dialogs, Resources, Fonts, PrintTraps, HyperXCmd; CONST idledlg = 9140; marginDefault = 36; throwAway = 5; scrollWidth = 18; wideExtra = 4; ourMask = everyEvent - keyDownMask - keyUpMask; PROCEDURE EntryPoint (paramPtr : XCmdPtr); IMPLEMENTATION PROCEDURE PrintField (paramPtr : XCmdPtr); FORWARD; PROCEDURE EntryPoint(paramPtr: XCMDPtr); BEGIN PrintField(paramPtr); END; PROCEDURE myStdRect (verb : GrafVerb; r : rect); { This procedure will replace the StdRect QuickDraw bottleneck procedure } { when we go into our printing loop. We use TEUpdate to draw text, and } { TEUpdate calls EraseRect to clear the way before it draws anything. } { On a blank sheet of paper, there's no need to erase, so we replace the } { QuickDraw bottleneck that handles rectangles with a "do-nothing" procedure. } { This has two advantages when printing on the LaserWriter: } { 1) Printing becomes faster, and } { 2) A problem is avoided--the rectangles erased sometimes included the } { descenders of lines of text already drawn. This happened with PrintField 1.0, } { which produced lines of text that were cut off at the bottom when the lineHeight } { of the field was smaller than about 4/3 of the average character height. } BEGIN END; FUNCTION GetScreenBitsBounds: Rect; { get screenbits.bounds from the QuickDraw globals } TYPE LongwordPtr = ^LONGINT; BitMapPtr = ^BitMap; CONST screenBitsOffset = -122; CurrentA5 = $904; VAR screenBitsPtr : BitMapPtr; myLongwordPtr : LongwordPtr; BEGIN myLongwordPtr := LongwordPtr(CurrentA5); { myLongwordPtr now points to the pointer to the first QD global } myLongwordPtr := LongwordPtr(myLongwordPtr^); { myLongwordPtr now points to the first QD global } screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset); { screenBitsPtr now points to the screenBits BitMap } GetScreenBitsBounds := screenBitsPtr^.bounds; END; FUNCTION GetField (paramPtr : XCmdPtr; whichField : Str255; VAR theHandle : Handle) : OSErr; { Given a valid designation of a field--by name, id, or number, } { returns the text of the field in a handle. } { We go through all of this to make sure we're printing the contents of } { a real field, and not just of an ordinary container, because later we'll } { be using field properties--lineHeight and so on--in order to format our output. } VAR theString : Str255; cardFieldFlag : BOOLEAN; matchPtr : Ptr; theResult : Handle; fieldID : INTEGER; BEGIN theResult := EvalExpr(paramPtr, CONCAT('the long name of ', whichField)); { if HC can get the long name of the object designated by whichField, it's a valid object } IF (theResult <> NIL) AND (paramPtr^.result = noErr) THEN BEGIN MoveHHi(theResult); HLock(theResult); matchPtr := StringMatch(paramPtr, 'field', theResult^); { if the long name of the object contains the word "field," then it's a field } IF matchPtr <> NIL THEN BEGIN matchPtr := StringMatch(paramPtr, 'card field', theResult^); { we want to know if it's a card or background field in order } { to set the cardFieldFlag for GetFieldbyID, below } cardFieldFlag := (matchPtr <> NIL); DisposHandle(theResult); theResult := EvalExpr(paramPtr, CONCAT('the id of ', whichField)); { we get the id of the field so that we can call GetFieldbyID } IF (theResult <> NIL) AND (paramPtr^.result = noErr) THEN BEGIN MoveHHi(theResult); HLock(theResult); ZeroToPas(paramPtr, theResult^, theString); fieldID := StrToNum(paramPtr, theString); DisposHandle(theResult); theResult := GetFieldByID(paramPtr, cardFieldFlag, fieldID); { get the text } END; { if theResult <> nil when asking for the id of the field } END { if "field" is part of the long name of the object } ELSE BEGIN DisposHandle(theResult); theResult := NIL; END; END; { if theResult <> nil when asking for the long name of the object } theHandle := theResult; GetField := paramPtr^.result; END; { function GetField } FUNCTION GetRectOfField (paramPtr : XCmdPtr; whichField : Str255) : Rect; VAR theRect : rect; FUNCTION GetRectItem (theItem : INTEGER) : INTEGER; VAR theResult : Handle; s: Str255; rectItemStr : Str255; BEGIN NumToStr(paramPtr, theItem, s); theResult := EvalExpr(paramPtr, CONCAT('item ', s, ' of the rect of ', whichField)); IF theResult <> NIL THEN BEGIN ZeroToPas(paramPtr, theResult^, rectItemStr); DisposHandle(theResult); GetRectItem := StrToNum(paramPtr, rectItemStr); END ELSE GetRectItem := 0; END; BEGIN theRect.left := GetRectItem(1); theRect.top := GetRectItem(2); theRect.right := GetRectItem(3); theRect.bottom := GetRectItem(4); GetRectOfField := theRect; END; FUNCTION GetJustOfField (paramPtr : XCmdPtr; whichField : Str255) : INTEGER; VAR theResult : Handle; textAlign : INTEGER; theStr : Str255; BEGIN theResult := EvalExpr(paramPtr, CONCAT('the textAlign of ', whichField)); ZeroToPas(paramPtr, theResult^, theStr); DisposHandle(theResult); IF theStr = 'left' THEN textAlign := teJustLeft ELSE IF theStr = 'center' THEN textAlign := teJustCenter ELSE IF theStr = 'right' THEN textAlign := teJustRight ELSE textAlign := teJustLeft; GetJustOfField := textAlign; END; FUNCTION GetFontOfField (paramPtr : XCmdPtr; whichField : Str255) : INTEGER; VAR theResult : Handle; fontNumber : INTEGER; fontName : Str255; BEGIN theResult := EvalExpr(paramPtr, CONCAT('the textFont of ', whichField)); ZeroToPas(paramPtr, theResult^, fontName); DisposHandle(theResult); GetFNum(fontName, fontNumber); GetFontOfField := fontNumber; END; FUNCTION GetTextSizeOfField (paramPtr : XCmdPtr; whichField : Str255) : INTEGER; VAR theResult : Handle; theSize : INTEGER; sizeStr : Str255; BEGIN theResult := EvalExpr(paramPtr, CONCAT('the textSize of ', whichField)); ZeroToPas(paramPtr, theResult^, sizeStr); DisposHandle(theResult); theSize := StrToNum(paramPtr, sizeStr); GetTextSizeOfField := theSize; END; FUNCTION GetLineHeightOfField (paramPtr : XCmdPtr; whichField : Str255) : INTEGER; VAR theResult : Handle; theLineHeight : INTEGER; heightStr : Str255; BEGIN theResult := EvalExpr(paramPtr, CONCAT('the textHeight of ', whichField)); ZeroToPas(paramPtr, theResult^, heightStr); DisposHandle(theResult); theLineHeight := StrToNum(paramPtr, heightStr); GetLineHeightOfField := theLineHeight; END; PROCEDURE AdjustForScrBarsAndWdMargins (paramPtr : XCmdPtr; whichField : Str255; VAR theRect : rect); { Given the rect of a field, adjusts the rectangle to make it the smallest } { rectangle containing the text of the field visible on the screen } VAR theResult : Handle; theLineHeight : INTEGER; theStr : Str255; BEGIN { if the field has wide margins, we shrink the rectangle by wideExtra pixels all around } theResult := EvalExpr(paramPtr, CONCAT('the wideMargins of ', whichField)); ZeroToPas(paramPtr, theResult^, theStr); DisposHandle(theResult); IF theStr = 'true' THEN InsetRect(theRect, wideExtra, 0); { if it's a scrolling field, we subtract scrollWidth from the right coordinate of the rect } theResult := EvalExpr(paramPtr, CONCAT('the style of ', whichField)); ZeroToPas(paramPtr, theResult^, theStr); DisposHandle(theResult); IF theStr = 'scrolling' THEN WITH theRect DO right := right - scrollWidth; END; FUNCTION GetTextStyleOfField (paramPtr : XCmdPtr; whichField : Str255) : Style; VAR theTextStyle : Handle; thePtr : Ptr; theStyle : Style; FUNCTION StyleIs (textStyle : handle; aStyle : Str255) : BOOLEAN; VAR thePtr : Ptr; BEGIN thePtr := StringMatch(paramPtr, aStyle, textStyle^); IF thePtr <> NIL THEN StyleIs := TRUE ELSE StyleIs := FALSE; END; BEGIN theStyle := []; theTextStyle := EvalExpr(paramPtr, CONCAT('the textStyle of ', whichField)); IF theTextStyle <> NIL THEN BEGIN IF StyleIs(theTextStyle, 'bold') THEN theStyle := theStyle + [bold]; IF StyleIs(theTextStyle, 'italic') THEN theStyle := theStyle + [italic]; IF StyleIs(theTextStyle, 'underline') THEN theStyle := theStyle + [underline]; IF StyleIs(theTextStyle, 'outline') THEN theStyle := theStyle + [outline]; IF StyleIs(theTextStyle, 'shadow') THEN theStyle := theStyle + [shadow]; IF StyleIs(theTextStyle, 'condense') THEN theStyle := theStyle + [condense]; IF StyleIs(theTextStyle, 'extend') THEN theStyle := theStyle + [extend]; DisposHandle(theTextStyle); END; GetTextStyleOfField := theStyle; END; PROCEDURE PrintField (paramPtr : XCmdPtr); VAR currentPort : grafPtr; myDlgPtr : DialogPtr; myDITL, myDLOG : Handle; dlogOK, goAhead : BOOLEAN; prRecHdl : THPrint; myStRec : TPrStatus; myPrPort : TPPrPort; theText : Handle; hTE : TEHandle; length : longint; theTextStyle : Style; theTextFont, theTextSize, theTextHeight, just : INTEGER; FontIRec : FontInfo; fieldName, str : Str255; fieldRect, destRect, viewRect : rect; fieldWidth, pageHeight, numLines, numCopies, myPgCount : INTEGER; parameterCount, leftMargin, rightMargin, topMargin, bottomMargin : INTEGER; dialogCount : LONGINT; err : OSErr; goToThisCard : Str255; curs: CursHandle; PROCEDURE Fail (errMsg : Str255); { set theResult and quit } BEGIN paramPtr^.returnValue := PasToZero(paramPtr, errMsg); END; FUNCTION GetDialog: BOOLEAN; { check to see if DLOG and DITL are present; } VAR { if so, put up the dialog } dlogPresent : BOOLEAN; BEGIN dlogPresent := FALSE; myDLOG := GetResource('DLOG', idledlg); IF (myDLOG <> NIL) AND (ResError = noErr) THEN BEGIN myDITL := GetResource('DITL', idledlg); dlogPresent := (myDITL <> NIL) AND (ResError = noErr); IF dlogPresent THEN myDlgPtr := GetNewDialog(idledlg, NIL, NIL); END; GetDialog := dlogPresent; END; PROCEDURE ShowDialog; { Here we mess with the appearance of the dialog. We center it on the screen, } { and also center the text items within the dialog. } { Also, we grab the document name and make it the window title, so that the } { printer driver can access that information -- see Tech Note #72. } VAR mainScreenRect, dlogRect : rect; hGlobal : INTEGER; theDialogTHndl : DialogTHndl; wMgrPort : GrafPtr; wTitle : Str255; theResult : Handle; PROCEDURE CenterTextItem (theDialogPtr : DialogPtr; itemNo : INTEGER); VAR savePort : grafPtr; item : handle; itemType : INTEGER; dlogRect, itemBox : Rect; theStr : Str255; width, textLeft : INTEGER; BEGIN GetDItem(theDialogPtr, itemNo, itemType, item, itemBox); IF item <> NIL THEN IF (itemType = statText) OR (itemType = statText + itemDisable) THEN BEGIN GetPort(savePort); SetPort(theDialogPtr); GetIText(item, theStr); width := StringWidth(theStr) + 6; IF itemNo = 1 THEN { kludge for getting the width of an item that includes paramText } width := width - StringWidth('^0') + StringWidth(wTitle); dlogRect := theDialogPtr^.portRect; WITH dlogRect DO textLeft := (right - left - width) DIV 2; WITH itemBox DO BEGIN left := textLeft; right := textLeft + width; END; SetDItem(theDialogPtr, itemNo, itemType, item, itemBox); SetPort(savePort); END; END; BEGIN IF dlogOK THEN BEGIN theResult := EvalExpr(paramPtr, CONCAT('the short name of ', fieldName)); IF theResult <> NIL THEN BEGIN ZeroToPas(paramPtr, theResult^, wTitle); DisposHandle(theResult); END ELSE wTitle := fieldName; SetWTitle(myDlgPtr, wTitle); ParamText(wTitle, '', '', ''); CenterTextItem(myDlgPtr, 1); CenterTextItem(myDlgPtr, 2); myDLOG := GetResource('DLOG', idledlg); theDialogTHndl := DialogTHndl(myDLOG); { we get the rect of the dialog directly from its DLOG resource in memory } dlogRect := theDialogTHndl^^.boundsRect; mainScreenRect := GetScreenBitsBounds; WITH mainScreenRect DO hGlobal := right - left; WITH dlogRect DO BEGIN hGlobal := (hGlobal - (right - left)) DIV 2; MoveWindow(myDlgPtr, hGlobal, top, FALSE); END; ShowWindow(myDlgPtr); BringToFront(myDlgPtr); DrawDialog(myDlgPtr); END; END; PROCEDURE SetDefaults; BEGIN viewRect := prRecHdl^^.prInfo.rPage; topMargin := marginDefault; bottomMargin := marginDefault; leftMargin := marginDefault; fieldRect := GetRectOfField(paramPtr, fieldName); AdjustForScrBarsAndWdMargins(paramPtr, fieldName, fieldRect); WITH fieldRect DO fieldWidth := right - left - throwAway; END; PROCEDURE GetDialogCount; BEGIN IF parameterCount > 1 THEN BEGIN ZeroToPas(paramPtr, paramPtr^.params[2]^, str); dialogCount := StrToNum(paramPtr, str); END { if parameterCount > 1 } ELSE dialogCount := 2; END; PROCEDURE GetMarginSettings; VAR theBottom : INTEGER; BEGIN IF parameterCount > 2 THEN BEGIN ZeroToPas(paramPtr, paramPtr^.params[3]^, str); leftMargin := StrToNum(paramPtr, str); IF leftMargin < 0 THEN leftMargin := marginDefault; IF parameterCount > 3 THEN BEGIN ZeroToPas(paramPtr, paramPtr^.params[4]^, str); rightMargin := StrToNum(paramPtr, str); IF rightMargin >= 0 THEN BEGIN WITH viewRect DO fieldWidth := right - left - leftMargin - rightMargin; IF fieldWidth < 10 THEN fieldWidth := 10; END; IF parameterCount > 4 THEN BEGIN ZeroToPas(paramPtr, paramPtr^.params[5]^, str); topMargin := StrToNum(paramPtr, str); IF topMargin < 0 THEN topMargin := marginDefault; IF parameterCount > 5 THEN BEGIN ZeroToPas(paramPtr, paramPtr^.params[6]^, str); bottomMargin := StrToNum(paramPtr, str); IF bottomMargin < 0 THEN bottomMargin := marginDefault; END; { if parameterCount > 5 } END; { if parameterCount > 4 } END; { if parameterCount > 3 } END; { if parameterCount > 2 } WITH viewRect DO BEGIN left := leftMargin; top := topMargin; right := leftMargin + fieldWidth; bottom := bottom - bottomMargin; IF bottom < top THEN bottom := top + 10 END; END; PROCEDURE GetFieldInfo; BEGIN just := GetJustOfField(paramPtr, fieldName); theTextFont := GetFontOfField(paramPtr, fieldName); theTextStyle := GetTextStyleOfField(paramPtr, fieldName); theTextSize := GetTextSizeOfField(paramPtr, fieldName); theTextHeight := GetLineHeightOfField(paramPtr, fieldName); END; PROCEDURE SetPPortInfo; BEGIN TextFont(theTextFont); TextFace(theTextStyle); TextSize(theTextSize); myPrPort^.gPort.txMode := srcOr; END; PROCEDURE AdjustViewRect; BEGIN { This will have to be modified if HyperCard ever uses the new Text Edit. } WITH viewRect DO pageheight := bottom - top; numlines := pageheight DIV theTextHeight; IF numlines < 1 THEN numlines := 1; pageheight := numlines * theTextHeight; WITH viewRect DO bottom := top + pageheight; GetFontInfo(FontIRec); destRect := viewRect; destRect.bottom := 32767; END; PROCEDURE GetPageCount; { This will have to be modified if HyperCard ever uses the new Text Edit. } BEGIN WITH hTE^^ DO BEGIN myPgCount := nLines DIV numlines; IF (nLines MOD numlines) <> 0 THEN myPgCount := myPgCount + 1; END; END; PROCEDURE SetTERec; BEGIN MoveHHi(theText); HLock(theText); length := StringLength(paramPtr, theText^); TESetText(theText^, length, hTE); DisposHandle(theText); TESetJust(just, hTE); WITH hTE^^ DO BEGIN txFont := theTextFont; txFace := theTextStyle; txSize := theTextSize; fontAscent := theTextHeight - FontIRec.descent - FontIRec.leading; lineHeight := theTextHeight; crOnly := 1; inPort := grafPtr(myPrPort); END; END; PROCEDURE PrintLoop; VAR copies, pg : INTEGER; BEGIN IF prRecHdl^^.prJob.bJDocLoop = bSpoolLoop THEN numCopies := 1 ELSE numCopies := prRecHdl^^.prJob.iCopies; FOR copies := 1 TO numCopies DO BEGIN FOR pg := 1 TO myPgCount DO BEGIN PrOpenPage(myPrPort, NIL); myPrPort^.gPort.grafProcs^.rectProc := @myStdRect; { It turned out that setting the bottlenecks any earlier didn't work -- } { PrOpenPage set them back to the postscript generating procedures. } IF PrError = noErr THEN TEUpdate(viewRect, hTE); PrClosePage(myPrPort); OffsetRect(hTE^^.destRect, 0, -pageHeight); END; { for pg := 1 to myPgCount } END; { for copies := 1 to numCopies } PrCloseDoc(myPrPort); IF (prRecHdl^^.prJob.bJDocLoop = bSpoolLoop) AND (PrError = noErr) THEN PrPicFile(prRecHdl, NIL, NIL, NIL, myStRec); END; PROCEDURE UserCancel; BEGIN Fail('Cancel'); END; BEGIN { procedure PrintField } parameterCount := paramPtr^.paramCount; IF parameterCount > 0 THEN BEGIN InitCursor; goToThisCard := 'go to this card'; dlogOK := GetDialog; ZeroToPas(paramPtr, paramPtr^.params[1]^, fieldName); err := GetField(paramPtr, fieldName, theText); IF (theText <> NIL) AND (err = noErr) THEN BEGIN HNoPurge(theText); GetPort(currentPort); PrOpen; IF PrError = noErr THEN BEGIN prRecHdl := THPrint(NewHandle(SIZEOF(TPrint))); IF (MemError = noErr) AND (prRecHdl <> NIL) THEN BEGIN PrintDefault(prRecHdl); IF PrError = noErr THEN BEGIN GetDialogCount; IF dialogCount IN [0, 1] THEN goAhead := TRUE ELSE BEGIN goAhead := PrStlDialog(prRecHdl); SendCardMessage(paramPtr, goToThisCard); END; IF goAhead THEN BEGIN IF dialogCount = 0 THEN goAhead := TRUE ELSE BEGIN goAhead := PrJobDialog(prRecHdl); SendCardMessage(paramPtr, goToThisCard); END; IF goAhead THEN BEGIN ShowDialog; IF PrValidate(prRecHdl) THEN ; { we call PrValidate here only to give the printer driver } { a chance to grab our document name -- see TN #72 } curs := GetCursor(watchCursor); SetCursor(curs^^); myPrPort := PrOpenDoc(prRecHdl, NIL, NIL); IF PrError = noErr THEN BEGIN SetDefaults; GetMarginSettings; GetFieldInfo; SetPPortInfo; AdjustViewRect; hTE := TENew(destRect, viewRect); IF hTE <> NIL THEN BEGIN SetTERec; GetPageCount; PrintLoop; TEDispose(hTE); END { if we could create new TEHandle } ELSE BEGIN PrCloseDoc(myPrPort); IF GetHandleSize(theText) > 0 THEN DisposHandle(theText); IF MemError <> noErr THEN BEGIN NumToStr(paramPtr, MemError, str); Fail(CONCAT('Error ', str)); END; END; END ELSE PrCloseDoc(myPrPort); InitCursor; END { if user confirms job dialog } ELSE UserCancel; END { if user confirms style dialog } ELSE UserCancel; END; { if PrintDefault worked OK } DisposHandle(Handle(prRecHdl)); END; { if MemError = noErr when allocating print record } PrClose; END; { if PrError = noErr when opening print driver } IF PrError <> noErr THEN BEGIN NumToStr(paramPtr, PrError, str); Fail(CONCAT('Error ', str)) END ELSE IF MemError <> noErr THEN BEGIN NumToStr(paramPtr, MemError, str); Fail(CONCAT('Error ', str)); END; SetPort(currentPort); END { if theText <> nil } ELSE Fail(CONCAT('Error -- never heard of ', fieldName)); IF dlogOK THEN DisposDialog(myDlgPtr); END { if we have at least 1 parameter } ELSE Fail('PrintField XCMD 1.5.1, 15 March 1989, ©1988-1989 Dartmouth College'); END; { procedure PrintField } END.